home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / PHRO.ZIP / FACE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-21  |  4KB  |  193 lines
  1. {   3D Phong Shaded Vector Face Source FIle    }
  2. {   PHRO!                                      }
  3. {   Phred/OTM                                  }
  4. {   achalfin@uceng.uc.edu                      }
  5. {   DO NOT DISTRIBUTE THIS SOURCE FILE         }
  6. Unit Face;
  7.  
  8. Interface
  9.  
  10. Procedure VectorFace;
  11.  
  12. Implementation
  13.  
  14. Uses Vector;
  15.  
  16. Type
  17.   tArray = Array[0..256*256-2] of Byte;
  18.   pArray = ^tArray;
  19.  
  20. Var
  21.   FaceVOPtr : Pointer;
  22.   StarVoPtr : Pointer;
  23.   EnvMap : pArray;
  24.   VPage : pArray;
  25.   EnvSine : Array[0..255] of Integer;
  26.  
  27. {$F+}
  28. {$L Facevo.Obj}
  29. Procedure FaceVO; External;
  30.  
  31. Procedure CalcSine;
  32.  
  33. Var
  34.   Count : Integer;
  35.  
  36. Begin
  37.   For Count := 0 to 255 do
  38.     EnvSine[Count] := Round(Sin(Count*Pi/256)*256);
  39. End;
  40.  
  41. Function FixedMul(M1, M2 : Integer) : Integer; Assembler;
  42.  
  43. Asm
  44.   Mov  ax,M1
  45.   IMul M2
  46.   db 0fh,0ach,0d0h,08h   { Shrd ax,dx,8 }
  47.   Mov  bx,63
  48.   IMul bx
  49.   db 0fh,0ach,0d0h,08h   { Shrd ax,dx,8 }
  50. End;
  51.  
  52. Procedure MakePhongEnv;
  53.  
  54. Var
  55.   PhiCount : Integer;
  56.   ThetaCount : Integer;
  57.  
  58. Begin
  59.   For PhiCount := 0 to 255 do
  60.     For ThetaCount := 0 to 255 do
  61.       EnvMap^[PhiCount Shl 8 + ThetaCount] := (FixedMul(EnvSine[PhiCount], EnvSine[ThetaCount]));
  62. End;
  63.  
  64. Procedure MotionClear(Var D; Step : Byte); Assembler;
  65.  
  66. Asm
  67.   Les  di,D
  68.   Mov  bl,Step
  69.   Mov  cx,64000
  70.  @Looper:
  71.   Mov al,es:[di]  
  72.   Sub al,bl       
  73.   Jns @SkipZero
  74.   Mov al,0
  75.  @SkipZero:
  76.   Mov es:[di],al  
  77.   Inc di
  78.   Dec  cx
  79.   Jnz @Looper
  80. End;
  81.  
  82. Procedure CopyPage(P : Pointer); Assembler;
  83.  
  84. Asm
  85.   Push  ds
  86.   Lds   si,P
  87.   Mov   ax,$A000
  88.   Mov   es,ax
  89.   Xor   di,di
  90.   db 66h; Mov  cx,16000; dw 0;
  91.   db 66h; Rep  Movsw
  92.   Pop   ds
  93. End;
  94.  
  95. Procedure ClearPage(P : Pointer); Assembler;
  96.  
  97. Asm
  98.   Les  di,P
  99.   db 66h; Xor ax,ax
  100.   db 66h; Mov cx,16000; dw 0;
  101.   db 66h; Rep Stosw
  102. End;
  103.  
  104. Procedure SetFadePalette(r1, g1, b1, r2, g2, b2, CStart, CEnd : Byte);
  105.  
  106. Var
  107.   RStep, GStep, BStep : Longint;
  108.   RVal, GVal, BVal : Longint;
  109.   Count : Integer;
  110.  
  111. Begin
  112.   RVal := Longint(R1) Shl 8;
  113.   GVal := Longint(G1) Shl 8;
  114.   BVal := Longint(B1) Shl 8;
  115.   RStep := Longint(R2-R1+1) Shl 8 Div (CEnd-CStart+1);
  116.   GStep := Longint(G2-G1+1) Shl 8 Div (CEnd-CStart+1);
  117.   BStep := Longint(B2-B1+1) Shl 8 Div (CEnd-CStart+1);
  118.   For Count := CStart to CEnd do
  119.     Begin
  120.       Port[$3c8] := Count;
  121.       Port[$3c9] := RVal Div 256;
  122.       Port[$3c9] := GVal Div 256;
  123.       Port[$3c9] := BVal Div 256;
  124.       RVal := RVal + RStep;
  125.       GVal := GVal + gStep;
  126.       BVal := BVal + bStep;
  127.     End;
  128. End;
  129.  
  130.  
  131.  
  132. Procedure VectorFace;
  133.  
  134. Var
  135.   Count : Integer;
  136.   Angle : Integer;
  137.  
  138. Begin
  139.   New(EnvMap);
  140.   New(VPage);
  141.   FillChar(VPage^[0], 64000, 0);
  142.   MakePhongEnv;
  143.   InitVectorRoutines(750);
  144.   LoadVectorObject(FaceVOPtr, 0, cPhongPoly);
  145.  
  146.   SelectEnable(0, 1, EnvMap);  { Enable face vector object, with phong tmap }
  147.   SetFadePalette(12, 0, 0, 48, 32, 0, 1, 49);
  148.   SetFadePalette(48, 32, 0, 63, 53, 43, 50, 63);
  149.   Angle := 0;
  150.   For Count := 50 downto 0 do
  151.     Begin
  152.       MotionClear(VPage^, 5);
  153.       Location(0, Count*4, 0, 200, 0, Angle, Angle);
  154.       DisplayVectorObjects(Seg(VPage^));
  155.       CopyPage(VPage);
  156.       Angle := (Angle + 3) and 511;
  157.     End;
  158.   For Count := -1 downto -50 do
  159.     Begin
  160.       MotionClear(VPage^, 5);
  161.       Location(0, Count*4, 0, 200, 0, Angle, Angle);
  162.       DisplayVectorObjects(Seg(VPage^));
  163.       CopyPage(VPage);
  164.       Angle := (Angle + 3) and 511;
  165.     End;
  166.  
  167.   Angle := 256;
  168.   For Count := 50 downto 0 do
  169.     Begin
  170.       MotionClear(VPage^, 5);
  171.       Location(0, 0, Count*4, 200, 0, Angle, Angle);
  172.       DisplayVectorObjects(Seg(VPage^));
  173.       CopyPage(VPage);
  174.       Angle := (Angle + 3) and 511;
  175.     End;
  176.   For Count := -1 downto -50 do
  177.     Begin
  178.       MotionClear(VPage^, 5);
  179.       Location(0, 0, Count*4, 200, 0, Angle, Angle);
  180.       DisplayVectorObjects(Seg(VPage^));
  181.       CopyPage(VPage);
  182.       Angle := (Angle + 3) and 511;
  183.     End;
  184.   FreeVectorObject(0);
  185.   CloseVectorRoutines;
  186.   Dispose(VPage);
  187.   Dispose(EnvMap);
  188. End;
  189.  
  190. Begin
  191.   CalcSine;
  192.   FaceVOPtr := @FaceVO;
  193. End.